;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                ;;;
;;;                           cl-famix                             ;;;
;;;                     (Common Lisp FAMIX library)                ;;;
;;;                        by Adrian DOZSA                         ;;;
;;;                                                                ;;;
;;;                        Processing Functions                    ;;;
;;;                                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; cl-famix package
 
(in-package :cl-famix)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Globals

(defvar *model*)
(defvar *current-package* nil)
(defvar *dummy-packages-list* '())
(defvar *macro-expand-table* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Processing functions

(defun init-work ()
  (setf *model* (make-instance 'lisp-model))
  (add-default *model*)
  (reset-id-gen)
  (setq *current-package* nil)
  (setq *dummy-packages-list* '())
  (setq *macro-expand-table* (make-hash-table)))

(defun cleanup-work ()
  (loop for package-name in *dummy-packages-list*
        do
        (ignore-errors (delete-package package-name)))
  (setq *dummy-packages-list* '())
  (clrhash *macro-expand-table*)
  (setq *macro-expand-table* nil)
  (xref:clear-tables))

(defun filter-lisp-files (directory fun)
  (if (file-exists-p directory)
      (walk-directory directory
                      (lambda (file)              
                        (if (directory-pathname-p file)
                            (add-folder file)
                          (when (equal (pathname-type file) "lisp")
                            (add-file file)
                            (funcall fun file)))))
    (error "Pathname ~A doesn't exists" directory)))

(defun read-lisp-forms-from-file (file fun)
  (with-open-file (stream file)
    (loop for form = (ignore-errors (read stream nil 'EOF))
          while (not (eql form 'EOF))
          when (and form
                    (listp form))
          do 
          (funcall fun form))))

(defun process-files (path &key verbose)
  (filter-lisp-files path
                     (lambda (file)    
                       (when verbose
                         (format t "~%   processing file ~A" file))
                       (setf *current-package* 'cl-user)
                       (read-lisp-forms-from-file file
                                                  (lambda (form)
                                                    (parse-form (first form) form))))))

(defun prescan-file (file)
  (with-open-file (stream file)
    (loop for form = (ignore-errors (read stream nil 'EOF))          
          while (not (eql form 'EOF))
          when (listp form)
          do
          (if (equal (first form)
                     'defpackage)           
              (when (null (find-package (second form)))
                (when (ignore-errors (eval (subseq form 0 2)))
                  (setf *dummy-packages-list*
                        (cons (second form)
                              *dummy-packages-list*))))
            (let ((def (find-def 'defpackage form)))
              (when def
                (when (null (find-package (second def)))
                  (when (ignore-errors (eval (subseq def 0 2)))
                    (setf *dummy-packages-list*
                          (cons (second def)
                                *dummy-packages-list*))))))))))

(defun prescan-files (folder)
  (when (file-exists-p folder)
    (walk-directory folder
                    (lambda (file)           
                      (when (and (not (directory-pathname-p file))
                                 (equal (pathname-type file) "lisp"))  
                        (prescan-file file))))))

(defun create-xref-table (folder)
  (when (file-exists-p folder)
    (xref:clear-tables)
    (let ((xref::*HANDLE-MACRO-FORMS* nil))
    (walk-directory folder
                    (lambda (file)           
                      (when (and (not (directory-pathname-p file))
                                 (equal (pathname-type file) "lisp"))  
                        (xref:xref-file file nil nil)))))))

(defun create-macro-expand-table (folder)
  (let ((macro-list (filter-elements *model*
                                     :type 'FAMIX.Macro)))
    (loop for macro in macro-list
          for calls = (xref:list-callees (name macro))
          do
          (setf (gethash (name macro) *macro-expand-table*) calls)))

  (when (file-exists-p folder)
    (xref:clear-tables)
    (let ((xref::*HANDLE-QUOTE-FORMS* t)
          (xref::*HANDLE-MACRO-FORMS* nil))
      (walk-directory folder
                      (lambda (file)           
                        (when (and (not (directory-pathname-p file))
                                   (equal (pathname-type file) "lisp"))  
                          (xref:xref-file file nil nil))))))
  
  (let ((macro-list (filter-elements *model*
                                     :type 'FAMIX.Macro)))
    (loop for macro in macro-list
          for new-calls = (xref:list-callees (name macro))
          for old-calls = (gethash (name macro) *macro-expand-table*)
          do
          (setf (gethash (name macro) *macro-expand-table*) 
                (set-difference new-calls old-calls)))))

(defun load-folder (folder &rest parameters)
  (when (and (file-exists-p folder)
             (directory-pathname-p folder))
    (walk-directory folder
                    (lambda (file)       
                      (when (and (not (directory-pathname-p file))
                                 (equal (pathname-type file) "lisp"))  
                        (apply #'load 
                                 (cons file parameters)))))))

(defun read-eval (path &key verbose)
  (filter-lisp-files path
                     (lambda (file)    
                       (when verbose
                         (format t "~%loading file ~A" file))
                       (read-lisp-forms-from-file file
                                                  (lambda (form)
                                                    (ignore-warnings
                                                      (ignore-errors
                                                        (eval form))))))))

(defun read-eval-scan (path)
  (when (file-exists-p path)
      (read-eval path)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
